home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ole / ole2.frm (.txt) < prev   
Encoding:
Visual Basic Form  |  1995-05-08  |  7.2 KB  |  243 lines
  1. VERSION 2.00
  2. Begin Form frm_main 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "OLE Destination Example"
  5.    ClientHeight    =   3180
  6.    ClientLeft      =   2025
  7.    ClientTop       =   2295
  8.    ClientWidth     =   3885
  9.    Height          =   3870
  10.    Left            =   1965
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    ScaleHeight     =   80.379
  14.    ScaleMode       =   0  'User
  15.    ScaleWidth      =   101.39
  16.    Top             =   1665
  17.    Width           =   4005
  18.    Begin OLE ole_Destination 
  19.       fFFHk           =   -1  'True
  20.       Height          =   3135
  21.       HostName        =   "OLE Demo"
  22.       Left            =   0
  23.       TabIndex        =   0
  24.       Top             =   0
  25.       Verb            =   -1
  26.       Width           =   3855
  27.    End
  28.    Begin Menu mnuFile 
  29.       Caption         =   "&File"
  30.       Begin Menu mnuExit 
  31.          Caption         =   "E&xit"
  32.       End
  33.    End
  34.    Begin Menu mnuedit 
  35.       Caption         =   "&Edit"
  36.       Begin Menu mnuName 
  37.          Caption         =   "None"
  38.          Enabled         =   0   'False
  39.          Begin Menu mnuVerbs 
  40.             Caption         =   "Verbs"
  41.             Index           =   0
  42.          End
  43.       End
  44.       Begin Menu mpaste 
  45.          Caption         =   "&Paste"
  46.       End
  47.       Begin Menu mplink 
  48.          Caption         =   "Paste &Link"
  49.       End
  50.       Begin Menu mnuPasteSpecial 
  51.          Caption         =   "Paste &Special"
  52.       End
  53.       Begin Menu mnuInsert 
  54.          Caption         =   "&Insert Object"
  55.       End
  56.       Begin Menu sep 
  57.          Caption         =   "-"
  58.       End
  59.       Begin Menu mdel 
  60.          Caption         =   "&Delete Object"
  61.       End
  62.       Begin Menu mnuSep2 
  63.          Caption         =   "-"
  64.       End
  65.       Begin Menu mnuUpdate 
  66.          Caption         =   "&Update"
  67.       End
  68.    End
  69. Option Explicit
  70. Dim aPath As String
  71. Sub Form_Load ()
  72.     Dim FileNum ' Declare variable.
  73. '   Get startup Path of OLE2 Application
  74.     aPath = app.Path
  75.     If Right$(aPath, 1) <> "\" Then
  76.     aPath = aPath + "\"
  77.     End If
  78. '   Setup file for OLE
  79. '   If present read and restore OLE control
  80.     FileNum = FreeFile  ' Get a valid file number.
  81.     On Error GoTo oleErr
  82.     Open aPath & "oleTst.OLE" For Binary As FileNum   ' Open file to be saved.
  83.     ole_Destination.FileNumber = FileNum ' Set the OLEClient filenumber.
  84.     ole_Destination.Action = 12  ' read the file.
  85.     Close #FileNum  ' Close the file.
  86.     mnuName.Caption = ole_Destination.Class
  87. continue:
  88.     If windowstate = 1 Then Exit Sub
  89.     Me.ScaleMode = 1
  90.     Me.Width = (ole_Destination.Width + 300)
  91.     Me.Height = (ole_Destination.Height + 800)
  92.     Me.ScaleMode = 6
  93.     Exit Sub
  94. oleErr:
  95. '   OLETST.OLE file not found OK OLE Object set to NULL
  96.     Close #FileNum  ' Close the file.
  97.     mnuName.Caption = "No Object"
  98.     Resume continue
  99. End Sub
  100. Sub Form_Unload (Cancel As Integer)
  101.     Dim FileNum ' Declare variable.
  102. '   If object is in OLE control save it to file!
  103.     If ole_Destination.OLEType <> 3 Then
  104.     FileNum = FreeFile  ' Get a valid file number.
  105.     Open aPath & "oleTst.OLE" For Binary As FileNum   ' Open file to be saved.
  106.     ole_Destination.FileNumber = FileNum ' Set the OLEClient filenumber.
  107.     ole_Destination.Action = 11  ' Save the file.
  108.     Close #FileNum  ' Close the file.
  109.     Else
  110.     Kill aPath & "oletst.ole"   'Erase old OLE File
  111.     End If
  112. '   Stop execution of Application
  113.     End
  114. End Sub
  115. Sub mdel_Click ()
  116. '   Delete the OLE object in the OLE Control
  117.     If ole_Destination.OLEType = 3 Then
  118.     Beep
  119.     Else
  120.     ole_Destination.Action = 10      'Delete Object
  121.     '   Restore original size
  122.     If windowstate = 1 Then Exit Sub
  123.     Me.ScaleMode = 1
  124.     Me.Width = (ole_Destination.Width + 300)
  125.     Me.Height = (ole_Destination.Height + 800)
  126.     Me.ScaleMode = 6
  127.     End If
  128.     mnuName.Caption = "No Object"
  129. End Sub
  130. Sub mnuedit_Click ()
  131.     Dim Verb As Integer
  132. '   Check clipboard and greyout Edit commands
  133. '   as needed
  134.     If ole_Destination.PasteOK Then
  135.     mPaste.Enabled = True
  136.     mpLink.Enabled = True
  137.     mnuPasteSpecial.Enabled = True
  138.     Else
  139.     mPaste.Enabled = False
  140.     mpLink.Enabled = False
  141.     mnuPasteSpecial.Enabled = False
  142.     End If
  143.     If ole_Destination.OLEType = 3 Then  'None
  144.     mDel = False
  145.     mnuUpdate.Enabled = False
  146.     mnuName.Enabled = False
  147.     mnuInsert.Enabled = True
  148.     Else
  149.     mDel = True
  150.     mnuUpdate.Enabled = True
  151.     mnuName.Enabled = True
  152.     mnuInsert.Enabled = False
  153.     End If
  154. '   OLE Object Class name
  155. '   and cascade menu of verbs
  156. '   Set Form properties now that it contains an object.
  157.     On Error Resume Next
  158.     For Verb = 1 To ole_Destination.ObjectVerbsCount - 1
  159.     Load mnuVerbs(Verb - 1)
  160.     If Err = 360 Then       'Object already loaded.
  161.     Unload mnuVerbs(Verb - 1)
  162.     Load mnuVerbs(Verb - 1)
  163.     Err = 0
  164.     End If
  165.     mnuVerbs(Verb - 1).Caption = ole_Destination.ObjectVerbs(Verb - 1)
  166.     Next Verb
  167. End Sub
  168. Sub mnuExit_Click ()
  169.     Unload Me
  170. End Sub
  171. Sub mnuInsert_Click ()
  172. '   Use Insert Object Dialog Box to build new OLE
  173. '   Object.  User chooses OLE Application to
  174. '   create this new object from OLE Registration
  175. '   database (REG.DAT)
  176.     On Error GoTo insertErr
  177.     If ole_Destination.OLEType <> 3 Then
  178.     Beep
  179.     Exit Sub
  180.     End If
  181.     ole_Destination.Action = 14      'Insert Object Dialog Box
  182.     ole_Destination.Action = 7       'OLE Activate
  183.     mnuName.Caption = ole_Destination.Class
  184.     Exit Sub
  185. insertErr:
  186.     MsgBox "OLE ERROR - Inserting Object"
  187.     Resume 0
  188. End Sub
  189. Sub mnuPasteSpecial_Click ()
  190. '   Show Paste Special Dialog Box
  191. '   Allows user to choose Embed or Link type
  192.     If ole_Destination.PasteOK Then
  193.     ole_Destination.Action = 15  'Paste Special
  194.     Else
  195.     Beep
  196.     End If
  197.     mnuName.Caption = ole_Destination.Class
  198. End Sub
  199. Sub mnuUpdate_Click ()
  200. '   Update Object by calling OLE Application
  201.     ole_Destination.Action = 6   'Update Object
  202.     mnuName.Caption = ole_Destination.Class
  203. End Sub
  204. Sub mnuVerbs_Click (Index As Integer)
  205. '   Execute a verb to OLE Application
  206.     ole_Destination.Verb = Index
  207.     If UCase(mnuVerbs(Index).Caption) = "&EDIT" Then ole_Destination.Verb = -1    'In-Place-Edit
  208.     ole_Destination.Action = 7   'Activate
  209. End Sub
  210. Sub mpaste_Click ()
  211. '   Paste from Clipboard (Embedded Type)
  212.     ole_Destination.OLEType = 1  ' Embedded
  213.     If ole_Destination.PasteOK Then
  214.     ole_Destination.Action = 5   'Paste
  215.     Else
  216.     Beep
  217.     End If
  218.     mnuName.Caption = ole_Destination.Class
  219. End Sub
  220. Sub mplink_Click ()
  221. '   Paste from clipboard (Link Type)
  222.     ole_Destination.OLEType = 0  ' Linked
  223.     If ole_Destination.PasteOK Then
  224.     ole_Destination.Action = 5  'Paste
  225.     Else
  226.     Beep
  227.     End If
  228.     mnuName.Caption = ole_Destination.Class
  229. End Sub
  230. Sub ole_Destination_Updated (Code As Integer)
  231. '   Gets control when object was changed by
  232. '       OLE Application
  233.     Dim rc As Integer
  234.     If ole_Destination.OLEType = 3 Then
  235.     Exit Sub
  236.     End If
  237.     If windowstate = 1 Then Exit Sub
  238.     Me.ScaleMode = 1
  239.     Me.Width = (ole_Destination.Width + 300)
  240.     Me.Height = (ole_Destination.Height + 800)
  241.     Me.ScaleMode = 6
  242. End Sub
  243.